00100	TITLE LUMEN
00150	OPDEF OUTSTG [XWD 51140,0]
00200	
00300	LUMEN:
00400	
00500	;CLEAR RASTER TO DARKNESS.
00600		MOVE [BYTE (4)16,16,16,16,16,16,16,16,16]
00650		MOVEM RASTER
00700		MOVE 1,[XWD RASTER,RASTER+1]
00800		BLT 1,RASTER+15624
00900	
01000	JSR PASS3
01100	JSR OCCULT
01200	
01300	INIT 5,17
01400	SIXBIT/DSK/
01500	0
01600	HALT
01700	ENTER 5,[SIXBIT/VIEW/ ↔ SIXBIT/DAT/ ↔ 0 ↔ 0]
01800	HALT
01900	OUTPUT 5,[XWD -15633,RASTER-13 ↔ 0 ↔ 0]
02000	CLOSE 5,
02100	
02200	HALT
02300	
02400	0↔7↔0↔4↔374↔34↔0↔373↔0↔373↔15620
02500	
02600	RASTER:
02700	
02800	BLOCK 15630
02900	
     

00100	PASS3:	0
00200	BEGIN PASS3
00300		SETZM NLEAST#	;COUNT OF TRIANGLES
00500	;ACCUMULATORS
00600	A←←XY1←←KA←←0
00700	B←←XY2←←AC0←←LA←←1
00800	C←←XY3←←AC1←←2
00900	AA←←I1←←Z12←←LO←←LB←←KB←←3
01000	BB←←I2←←Z3I←←HI←←4
01100	CC←←I3←←C12←←MID←←5
01200	X1←←AB1←←6
01300	X2←←AB2←←7
01400	X3←←AB3←←10
01500	Y1←←AB←←11
01600	Y2←←CC3←←12
01700	Y3←←13
01800	Z1←←Z←←14
01900	Z2←←TRI←←15
02000	Z3←←LC←←16
02100	ZT←←QB←←II←←KK←←KC←←17
02200	KPLANE←1
     

00100	LOOP:	MOVE QB,NLEAST		;DONE YET  
00200		CAML QB,NUMTRI
00300		JRST @PASS3
00400	;BLIT TRIANGLE BLOCK INTO AC'S
00500		IMULI QB,5
00600		ADDI QB,INPUT3
00700		MOVSS QB
00800		BLT QB,4
00900	;UNPACK TRIANGLE BLOCK
01000		FOR @$ I←1,3 {
01100		HLRE X$I,XY$I
01200		HRRE Y$I,XY$I ⎇
01300		HLRE Z1,Z12
01400		HRRE Z2,Z12
01500		HLRE Z3,Z3I
01600		HRRZ II,Z3I
01700	P3B:
01800		TRNE II,4 ↔ SKIPA I1,[1] ↔ SETZ I1,
01900		TRNE II,2 ↔ SKIPA I2,[1] ↔ SETZ I2,
02000		TRNE II,1 ↔ SKIPA I3,[1] ↔ SETZ I3,
02100	P3A:
02200	;ORDER Z1 LEAST, Z3 MOST.
02300	DEFINE SWAP $ (N,M) {
02400	CAMG Z$N,Z$M
02500	JRST .+5
02600	EXCH X$N,X$M
02700	EXCH Y$N,Y$M
02800	EXCH Z$N,Z$M
02900	EXCH I$N,I$M ⎇
03000	SWAP 1,2
03100	SWAP 2,3
03200	SWAP 1,2
03300	
03400	MOVE II,I1	;RE-PACK I-BITS
03500	LSH  II,1
03600	IOR  II,I2
03700	LSH  II,1
03800	IOR  II,I3
03900	
04000	EXCH II,[KPLANE]
     

00100	;CALCULATE COEFFICIENTS OF THE PLANE OF THE TRIANGLE BY KRAMER'S RULE.
00200	DEFINE DET2B2 (A00,B11,B12,B21,B22) {
00300	MOVE B,B11
00400	MOVE C,B12
00500	IMUL B,B22
00600	IMUL C,B21
00700	SUB B,C
00800	IMUL B,A00 ⎇
00900	
01000	DEFINE DETERM (A11,A12,A13,A21,A22,A23,A31,A32,A33) {
01100	DET2B2 A11,A22,A23,A32,A33
01200	MOVE A,B
01300	DET2B2 A12,A21,A23,A31,A33
01400	SUB A,B
01500	DET2B2 A13,A21,A22,A31,A32
01600	ADD A,B ⎇
01700	
01800	DETERM KK,Y1,Z1,KK,Y2,Z2,KK,Y3,Z3
01900	MOVE AA,A
02000	DETERM X1,KK,Z1,X2,KK,Z2,X3,KK,Z3
02100	MOVE BB,A
02200	DETERM X1,Y1,KK,X2,Y2,KK,X3,Y3,KK
02300	MOVE CC,A
02400	DETERM X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
02500	MOVEM A,KSAVE#
02600	BRK:
02700	;HALFWORD OVERFLOW.
02800	DEFINE HALFOV (W,WW){
02900	MOVM W,WW
03000	CAIGE W,400000
03100	JRST .+10
03200	MOVE W,KSAVE	;OVERFLOW
03300	ASH W,-1
03400	MOVEM W,KSAVE
03500	ASH AA,-1
03600	ASH BB,-1
03700	ASH CC,-1
03800	JRST .-11
03900	⎇
04000	HALFOV A,AA
04100	HALFOV B,BB
04200	HALFOV C,CC
04300	P3C:
04400	;PACK PLANE COEFFICIENTS
04500	HRL BB,AA
04600	HRLS CC
04700	EXCH KK,[KPLANE]		;COL-1
     

00100	;CALCULATE LINE COEFFICIENTS
00200	DEFINE LINCOE (X1,X2,Y1,Y2,TA,TB,TC,X3,Y3) {
00300	MOVE TA,Y2
00400	MOVE TB,X1
00500	SUB TA,Y1	;(Y2-Y1)=a
00600	SUB TB,X2	;(X1-X2)=b
00700	HRL TC,TA
00800	HRR TC,TB
00900	IMUL TA,X1	; A*x1	
01000	IMUL TB,Y1	; B*y1
01100	ADD TA,TB
01200	MOVNS TA
01300	MOVM TB,TA
01400	CAIGE TB,400000
01500	JRST .+6
01600	HLRE TA,TC	;HALFWORD OVERFLOW CURE
01700	HRRE TB,TC
01800	ASH TA,-1
01900	ASH TB,-1
02000	JRST .-15	;JUMP TO THE  "HRL" ABOVE.
02100		;TA    c
02200		;TB    free
02300		;TC    a,,b
02400	;observe qqq sign convention  -  odd vertex positive.
02500		HLRE TB,TC
02600		IMUL TB,X3
02700		MOVEM TB,AC20
02800		HRRE TB,TC
02900		IMUL TB,Y3
03000		ADD TB,AC20
03100		ADD TB,TA
03200		JUMPGE TB,.+7
03300		MOVNS TA	;FLIP SIGN OF LINE COEFFICIENTS.
03400		HLRE TB,TC
03500		HRRE TC,TC
03600		MOVNS TB
03700		MOVNS TC
03800		HRL TC,TB
03900	⎇
04000	HRL QB,Z3
04100	LINCOE X1,X2,Y1,Y2,A,B,C,X3,Y3
04200	LINCOE X1,X3,Y1,Y3,LA,LB,LC,X2,Y2	;COL-2
04300	HRR CC,A	;PACK c3
04400	MOVEM KC,SAVKC#
04500	LINCOE X2,X3,Y2,Y3,KA,KB,KC,X1,Y1	;COL-4
04600	HRL Y1,X1
04700	MOVE X1,KC
04800	MOVE KC,SAVKC
     

00100	P3D:
00200	;PACK EVERYTHING INTO YOUR OLD KIT BAG AND SMILE SMILE SMILE
00300	; WOULD YOU BELIEVE A LONG TRIANGLE BLOCK   
00400	HRL Y2,X2
00500	HRL Y3,X3
00600	MOVE AB2,LC
00700	MOVE AB3,C
00800	MOVE 2,13
00900	HRL 1,0
01000	HRL 3,14
01100	HRR 3,15
01200	MOVE 0,11
01300	EXCH 1,12
01400	EXCH 5,12
01500	MOVE 11,4
01600	MOVE 4,17
01700	MOVE 13,KSAVE
01800	
01900	;PATCH FOR INTENSITY.
02000	PATCH1:	MOVEM 14,SAV14# ↔ MOVEM 15,SAV15#
02100	HLRE 14,11 ↔ ASH 14,-2
02200	HRRE 15,11 ↔ ASH 15,-2
02300	IMUL 14,14
02400	IMUL 15,15
02500	ADD 14,15
02600	HLRE 15,12 ↔ ASH 15,-2
02700	IMUL 15,15
02800	ADD 14,15
02900	
03000	MOVEM 14,DENOM#
03100	MOVEI 14,20
03200	MUL 14,15
03300	DIV 14,DENOM
03400	MOVNS 14
03500	ADDI 14,20
03600	PATCH2:
03700	
03800	;BLIT BLOCK INTO LONG BLOCK TABLE.
03900	MOVE 17,NLEAST
04000	IMULI 17,15
04100	ADDI 17,TRIBLKS
04200	MOVE 16,17
04300	ADDI 16,14
04400	BLT 17,@16
04500	MOVE 14,SAV14
04600	MOVE 15,SAV15
     

00100	P3E:
00200	;PUT TRIANGLE BLOCK POINTER INTO THE TRIANGLE TABLE
00300	;IN ORDER ON MINIMUM DEPTH.
00400		HRL ZT,Z
00500		MOVE TRI,NUMTRI
00600		SKIPN LO,NLEAST
00700		JRST [AOS NLEAST		;FIRST TIME ONLY.
00800			MOVEM ZT,TRITAB-1(TRI)
00900			JRST LOOP]
01000		SETZ HI,
01100	PUT1:	MOVE MID,LO	;MID:=(LO+HI+1)/2
01200		ADD MID,HI
01300		AOS MID
01400		ASH MID,-1
01500		MOVE LC,TRI	;FETCH Z(MID)
01600		SUB LC,MID
01700		HLRE A,TRITAB(LC)
01800		CAML Z,A
01900		JRST [CAMN LO,MID
02000			JRST PUT2
02100			CAMN HI,MID
02200			JRST PUT2
02300			MOVE LO,MID
02400			JRST PUT1]
02500		CAMN LO,MID
02600		JRST [AOS MID
02700			JRST PUT2]
02800		CAMN HI,LO
02900		JRST [AOS MID
03000			JRST PUT2]
03100		MOVE HI,MID
03200		JRST PUT1
03300	;MOVE THE LOWER PART OF THE TRIANGLE TABLE,
03400	;BETWEEN NLEAST AND MID,
03500	;DOWN CORE BY ONE WORD.
03600	PUT2:	CAMLE MID,NLEAST
03700		JRST PUT3
03800		MOVEI AC0,TRITAB
03900		ADD AC0,TRI
04000		MOVE AC1,AC0
04100		SUB AC0,NLEAST
04200		HRLS AC0
04300		SOS AC0
04400		SUB AC1,MID
04500		SOS AC1
04600		BLT AC0,@AC1
04700	PUT3:	AOS NLEAST
04800		SUB TRI,MID
04900		MOVEM ZT,TRITAB(TRI)
05000		JRST LOOP
05100	AC20:	0
05200	BEND
     

00100	OCCULT:	0
00200	BEGIN OCCULT
00300	;USE AND ABUSE OF ACCUMULATORS
00400	AC0←←0
00500	AC1←←1
00600	XM←←0
00700	YM←←1
00800	
00900	XL←2		;The window.
01000	XH←3
01100	YL←4
01200	YH←5
01300	
01400	X1←AA←←6	;The triangle.
01500	X2←BB←←7
01600	X3←CC←←10
01700	
01800	Y1←MINZ←←11
01900	Y2←MAXZ←←12
02000	Y3←13
02100	
02200	AB←←14		;Plane coefficients.
02300	C←←15
02400	
02500	T←16
02600	TT←17
02700	
02800	XO←←14
02900	YO←←15
03000	PB←←17
03100	
03200	ODD←←13
03300	NEW←←14
03400	OLD←←15
03500	
03600	XY←←11
03700	X←←6
03800	Y←←7
03900	Z←←10
04000	EPTR←←14
04100	BPTR←←15
04200	CTB←←17
     

00100	;O.O.R. - Occult Object Remover.
00300		hrl TT,numtri		;Triangle pointer.
00400		movns TT	;This op covertly Subtracts one from left half.
00500		hrri TT,tritab-1
00600		movem TT,triptr#
00700	
00800		movni XL,1000		;first window
00900		movei XH,1000
01000		movni YL,1000
01100		movei YH,1000
01200		FOR W IN (PENOLD,PENNEW,SUR,SUR3,APEN,ASUR,ASUR3){
01300		SETZM W}
01400		movei 377777
01500		movem ZH#
01600		movei sqrpdl+1
01700		movem sqrpdl
01800		movei outpdl+1
01900		movem outpdl
02000		jrst .V
02100	;Occult Window Loop.
02200	OWLOOP:	sos 1,sqrpdl
02300		caig 1,sqrpdl+1
02400		jrst @occult	;no more windows.
02500	
02600		hlre XL,-5(1)	;new window
02700		hrre XH,-5(1)
02800		hlre YL,-4(1)
02900		hrre YH,-4(1)
03000	
03100		hrre -3(1)	;back limit.
03200		movem ZH
03300	
03400		move (1)	;triangle pointer
03500		movem triptr
03600	
03700		move -2(1)	;ancesters
03800		movem apen#
03900		move -1(1)
04000		movem asur#
04100		hlrz -3(1)
04200		movem asur3#
04300	
04400		setzm pennew#	;descendants
04500		setzm penold#
04600		setzm sur#
04700		setzm sur3#
04800	
04900		subi 1,5
05000		movem 1,sqrpdl
05100		jrst .V
     

00100	;Virgin  -  scan for first triangle.
00200	.V:	jsr pns
00300		jrst [	movem minz,penzlo#
00400			movem maxz,penzhi#
00500			movem T,pennew
00600			jrst %PP]
00700		jrst owloop
00800		movem minz,surzlo#
00900		movem maxz,surzhi#
01000		hrlzm T,sur
01100	;One surrounder.
01200	.S:	jsr pns
01300		jrst [	caml minz,surzhi
01400			jrst .S			;B - penetrator is behind surrounder.
01500			movem T,pennew
01600			caml maxz,surzlo
01700			jrst %PS		;C - penetrator and surrounder conflict.
01800			movem minz,penzlo	;F - penetrator is in Front of surrounder
01900			movem maxz,penzhi
02000			jrst %PP]
02100		jrst alpha		;DISPLAY a surrounder.
02200		caml minz,surzhi
02300		jrst .S			;B - new surrounder is behind old surrounder.
02400		caml maxz,surzlo
02500		jrst [	movem minz,zlo#	;C - surrounders conflict.
02600			movem maxz,zhi#
02700			hrrm T,sur
02800			jrst %PP]
02900		movem minz,surzlo	;F - new surrounder is in front of old surrounder
03000		movem maxz,surzhi
03100		hrlm T,sur
03200		jrst .S
03300	
     

00100	SQRPDL:	.+1	;WINDOW SQUARE IN CORE PUSHDOWN LIST
00200		0	; XL XH
00300		0	; YL YH
00400		0	;sur3,,ZH
00500		0	; PEN1,,PEN2
00600		0	; SUR1,,SUR2
00700		0	; TRIPTR
00800	BITS←←=10	;NUMBER OF BITS OF DISPLAY RASTER.
00900		BLOCK (BITS*3+1)*6
01000	SQREND:
     

00100	;DISPLAY OUTPUT SURROUNDER.
00200	ALPHA:
00300		ADDI XL,1000
00400		ADDI XH,1000
00500		SUBI YL,1000
00600		SUBI YH,1000
00700		MOVMS YL
00800		MOVMS YH
00900		IMULI XL,374
01000		IMULI XH,374
01100		IMULI YL,374
01200		IMULI YH,374
01300		ASH XL,-12
01400		ASH XH,-12
01500		ASH YL,-12
01600		ASH YH,-12
01700		SUB YL,YH
01800		SUB XH,XL
01900	
02000		IMULI YH,34
02100		MOVE 10,XL
02200		IDIVI 10,11
02300		ADD YH,10
02400		IMUL 11,[-4]
02500		ADDI 11,40
02600		ROT 11,-6
02700		ADD 11,[POINT 4,RASTER(10),35]
02800	
02850		HLRZ T,SUR
02900		MOVE 6,14(T)
03000	
03100		MOVE 10,YH
03200		MOVE 7,YL
03300		DPB 6,11
03400		ADDI 10,34
03500		SOJGE 7,.-2
03600		IBP 11
03700		SOJGE XH,.-6
03800	
03900		JRST OWLOOP
     

00100	;OCCUPATION VOLUME
00200	
00300	;		Compute the occupation volume of the Triangle pointed
00400	;to by T for the window XL XH YL YH, find the minimum and maximum Z for all
00500	;corners of the window without exceeding the triangle's total volume z1
00600	;minimum to z3 maximum; if you are worth anything you have by now realized
00700	;that this will yield too large a volume for numerous penetrator cases
00800	;where the vertices aren't in the window and the corners aren't in the triangle
00900	;but it doesn't matter and will all come out correctly further along.
01000	
01100	OCCVOL:	0
01200		HLRE AA,11(T)		;PICKUP COEFFICIENTS OF TRIANGLE'S  PLANE.
01300		HRRE BB,11(T)
01400		HLRE CC,12(T)		
01500		SETCM T
01600		TLNE (5B2)	;IF EXTREME VERTICES ARE WITHIN...
01700		JRST .+4
01800		HLRE MINZ,3(T)	;THEN OCCUPATION VOLUME IS OBVIOUS.
01900		HLRE MAXZ,4(T)
02000		JRST @OCCVOL
02100		HRLZI MAXZ,400000	;Z1
02200		SETCAM MAXZ,MINZ	;Z3
02300	;calculte z-depth of window corners in the plane of the triangle.
02400	FOR I←0,3 
02500	{
02600		MOVE AC0,13(T)
02700		MOVE AC1,XL+(I∧1)
02800		IMUL AC1,AA
02900		SUB AC0,AC1
03000		MOVE AC1,YL+((I∧2)⊗-1)
03100		IMUL AC1,BB
03200		SUB AC0,AC1
03300		IDIV AC0,CC
03400		CAMGE AC0,MINZ
03500		MOVE MINZ,AC0
03600		CAMLE AC0,MAXZ
03700		MOVE MAXZ,AC0
03800	⎇
03900	;Clip window's projected volume to the extreme volume of the triangle.
04000		HLRE AC0,3(T)
04100		HLRE AC1,4(T)
04200		CAMLE AC0,MINZ
04300		MOVE MINZ,AC0
04400		CAMGE AC1,MAXZ
04500		MOVE MAXZ,AC1
04600	
04700	
04800	JRST @OCCVOL
     

00100	;P.O.S.  -  Penetrator, Outsider, Surrounder.
00200	pos:
00300	comment/ POS determines the relationship between a triangle and a window
00400		and skips respectively.  For penetrators it always calculates 
00500		vertex-within-bits,  For Pen & Surs it always calculates volume.
00600			Accumulators IN:   XL,XH,YL,YH, & T(right half).
00700		/
00800	
00900	;GET TRIANGLE'S COORDINATES INTO ACCUMULATORS.
01000	define gettac {
01100		hlre x1,0(T)
01200		hlre x2,1(T)
01300		hlre x3,2(T)
01400		hrre y1,0(T)
01500		hrre y2,1(T)
01600		hrre y3,2(T)
01700	}
01800		gettac
01900	
02000	;If all the corners of the triangle are to one side of the window,
02100	; then the triangle is Outside.
02200	
02300	define Outside $ (M,N,P,HL) {
02400		CAM$M P$HL,P$1  ↔  JRST .+5
02500		CAM$M P$HL,P$2  ↔  JRST .+3
02600		CAM$N P$HL,P$3  ↔  JRST pnsout 
02700	}
02800		Outside LE,g,X,H
02900		Outside LE,g,Y,H
03000		Outside GE,l,X,L
03100		Outside GE,l,Y,L
03200	
03300	
03400	;If any vertex of the Triangle is within the window,
03500	;	then it is a penetrator.
03600				;EDGE CASES.
03700	For @$ N←1,3 {
03800	caml X$N,XH ↔JRST[CAMN X$N,XH ↔ IOR T,[1⊗(=21-N)]↔ jrst .+7]
03900	caml XL,X$N ↔JRST[CAMN XL,X$N ↔ IOR T,[1⊗(=21-N)]↔ jrst .+5]
04000	caml Y$N,YH ↔JRST[CAMN Y$N,YH ↔ IOR T,[1⊗(=21-N)]↔ jrst .+3]
04100	camg YL,Y$N ↔JRST[CAMN YL,Y$N↔JRST[IOR T,[1⊗(=21-N)]↔JRST .+1]↔ ior T,[1⊗(=36-N)]↔JRST .+1]
04200	}
04300	
04400		tlnn T,(7b2)
04500		jrst .+3
04600		jsr occvol		;Found a Penetrator.
04700		jrst @pns
04800	
04900	
     

00100	;SURROUNDS 
00200	
00300	comment/	For each edge of the triangle,  if for every corner of
00400		the window QQQ is the same sign then that edge does not pass 
00500		thru the window.  The odd vertex is in the opposite half plane
00600		from the window if the QQQs are all negative  -  which is
00700		equivalent to saying that the triangle is outside of the window.
00800		/
00900		jsr calq
01000		jrst pnsout		;OUTSIDE.
01100		tlne T,77770
01200		jrst [jsr occvol   ↔   jrst @pns]		;PENETRATOR.
01300		jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh	;lower ZH - SURROUNDER.
01400		aos pns
01500		aos pns
01600		jrst @pns
01700	
01800	;P.N.S  -  Penetrator, Nil list, Surrounder.
01900	pns:	0
02000	;Get pointer to next triangle, if list is empty or triangle is
02100	;beyond the back limit then take the NIL exit.
02200	pnsout:	skipe T,asur			;Check for ancestors.
02300		jrst [hlrzs T			;left SUR 1.
02400		      jumpe T,[exch T,asur	;right SUR 2
02500			       jrst pnssur]
02600		      hrrzs asur
02700		      jrst pnssur]
02800		skipe T,asur3
02900		jrst [setzm asur3
03000		      jrst pnssur]
03100		skipe T,apen
03200		jrst [hlrzs T			;left PEN 1
03300		      jumpe T,[exch T,apen	;right pen 2
03400			       jrst pos]
03500		      hrrzs apen
03600		      jrst pos]
03700		move TT,Triptr
03800	beyond:	aobjp TT,[aos pns
03900			  jrst @pns]
04000		movem TT,Triptr
04100		hrrz T,(TT)
04200		hlre (TT)
04300		caml zh
04400		jrst @beyond		;beyond ZH.
04500		jrst pos
04600	pnssur:	jsr occvol ↔ camge maxz,zh ↔ movem maxz,zh	;lower Zh.
04700		aos pns			;surrounds
04800		aos pns
04900		jrst @pns
     

00100	;Calculate QQQ-bits, skip if not outside.
00200	calq:	0
00300			movsi PB,40000		;Select QQQ bit.
00400	define qqq (corner) {
00500			hlre ac1,AB
00600			hrre ac0,AB
00700			imul ac1,XL+ (corner ∧ 1)
00800			imul ac0,YL+((corner ∧ 2)⊗-1)
00900			add ac1,ac0
01000			add ac1,C
01100	}
01200	
01300	for  edge ← 1,3 {
01400			move AB,5+edge(T)	;Get line Coefficients
01500		IFE (edge-1),<hlre C,5(T)>
01600		IFE (edge-2),<hrre C,5(T)>
01700		IFE (edge-3),<hrre C,12(T)>
01800	for corner ← 0,3 {
01900		qqq corner
02000		skipge ac1		;Q sign convention - odd vertex positive.
02100		ior T,PB
02200		rot PB,-1
02300	}
02400	
02500		setcm ac1,T
02600		tlnn ac1,(17⊗(=33-edge*4))
02700		jrst @calq			;Triangle outside of window.
02800	}
02900		aos calq
03000		jrst @calq
     

00100	;Convert QQQ-bits into Pen-bits.
00200	CONQQQ:	0
00300		gettac
00400	;Accumulators  IN:  XL,XH,YL,YH  (the window)
00500	;		    X1,X2,X3,Y1,Y2,Y3 (the triangle)
00600	;		    T (the triangle pointer)
00700	;Accumulators clobbered 0,1,14,15.
00800		tlne T,(7B2)	;If a vertex is within, then we must calQ.
00900		jrst [		      jsr calq
01000		      jfcl
01100		      jrst .+1]
01200	for @$ edge←1,3 {
01300	BP←←2+edge*4	;Bit pointer for testing.
01400	V ←←((7-edge)*edge)/2	;non-edge select bits.
01500		setcm T		;If both vertices within,
01600		tlne (V ⊗=33)
01700		jrst .+3
01800		tlz T,(17⊗(=35-BP))	;Then zero NSEW byte.
01900		jrst conq$edge
02000	;Convert 4-bit byte by table lookup.
02100		ldb ac1,[point 4,T,BP]
02200		move [ 0 ↔ 12 ↔ 11 ↔ 3 ↔  6 ↔ 14 ↔ 0 ↔  5
02300		       5 ↔  0 ↔ 14 ↔ 6 ↔  3 ↔ 11 ↔ 12 ↔ 0](ac1)
02400		tlne T,(V ⊗ =33)	;If both vertices without
02500		jrst .+6
02600		dpb [point 4,T,BP]
02700		movei 1,V
02800		jsr skpcruz
02900		tlz T,(17⊗(=35-bp))	;no crossings - zip NSEW.
03000		jrst conq$edge	;Then we are done, Else:
03100	;Find vertex that is outside the window.
03200	selec1←←(IFE(1-edge),<1+>0)	;1,0,0 - first select.
03300	selec2←←(IFE(3-edge),<1+>1)	;2,2,1 - second select.
03400		tlne T,(1⊗(=35-selec1))
03500		;First selected bit is inside, hence second is outside.
03600		jrst [
03700		move XO,X1+selec2
03800		move YO,Y1+selec2
03900		jrst .+3]
04000	
04100		;First selected bit is outside.
04200		move XO,X1+selec1
04300		move YO,y1+selec1
04400	
04500	;Call one-crossing routine & you are done.
04600		jsr cross
04700		dpb [point 4,T,BP]
04800	conq$edge:
04900	}
05000	jrst @conqqq
     

00100	CROSS:	0
00200	
00300	comment /	The following tortured logic converts qqq-bits (which
00400		tell which half plane the window corners are in with respect
00500		to the lines determined by the triangle) into pen-bits (which 
00600		tell which sides of the window: North, South, East or West, each
00700		triangle edge segment crosses).
00800	
00900		Accumulators:  XO,YO & AC1.
01000		/
01100	
01200	;If the 2-bit is on
01300	trne 2  ↔  jrst [
01400	;then
01500	
01600		;If XO ≥ XH
01700		caml XO,XH  ↔  jrst [
01800		;Then 2-mask
01900			andi 2
02000			jrst @cross ]
02100		;Else 15-mask
02200			andi 15
02300			jrst @cross ]
02400	
02500	;Else
02600		;If 10-bit is on
02700		trne 10  ↔  jrst [
02800		;Then If YO ≥ YH
02900			caml YO,YH  ↔  jrst [
03000			;Then 10-mask
03100				andi 10
03200				jrst @cross]
03300			;Else 5-mask
03400				andi 5
03500				jrst @cross]
03600		;Else If XL > XO
03700			camle XL,XO  ↔ jrst [
03800			;Then 1-mask
03900				andi 1
04000				jrst @cross]
04100			;Else 4-mask
04200				andi 4
04300				jrst @cross
04400	
04500	;SKIPs if outsiders' edge crosses window.  No crossings - no Skippings.
04600	skpcruz:	0
04700	setz
04800	for @$ i←1,3 {
04900	camle x$i,XL 
05000	tro 1⊗(3-i)
05100	camle y$i,yl
05200	tro 1⊗(22-i)
05300	camle xh,x$i
05400	tlo 1⊗(3-i)
05500	camle yh,y$i
05600	tlo 1⊗(22-i)
05700	}
05800	tdnn 1	↔ jrst @skpcruz
05900	tsnn 1 	↔ jrst @skpcruz
06000	rot 3
06100	tdnn 1	↔ jrst @skpcruz
06200	tsnn 1	↔ jrst @skpcruz
06300	aos skpcruz
06400	jrst @skpcruz
     

00100	;Save Father's surrounders  &  penetrators  and EXIT.
00200	%SSS: ↔ %PSS: ↔ %PPS: ↔ %PP: ↔ %PS:
00300		move 11,ZH
00400		hrl 11,sur3
00500		move 12,penold
00600		hrl 12,pennew
00700		move 13,sur
00800		move 14,triptr
00900	;Split up the window,  Recursion Exit.
01000	rexit:	move XM,XL
01100		move YM,YL
01200		add XM,XH
01300		add YM,YH
01400		ash XM,-1
01500		ash YM,-1
01600	;RESOLUTION DISPLAY OUTPUT.
01700	MOVE 6,XH ↔ SUB 6,XL ↔ CAIG 6,1 ↔ JRST OWLOOP
03700	
03800		move 6,sqrpdl	;setup blit pointer
03900		hrli 6,7
04000		move 15,6
04100		move 16,6
04200		move 17,6
04300		addi 16,6
04400		addi 17,14
04500		move  7,XH	;lower-right-window
04600		move 10,YM
04700		hrl   7,XM
04800		hrl  10,YL
04900		blt  15,5(6)
05000		movss 7		;lower-left-window
05100		hrl   7,XL
05200		blt  16,13(6)
05300		movss 10	;upper-left-window
05400		hrr   10,YH
05500		blt   17,21(6)
05600		addi   6,22
05700		HRRZM  6,sqrpdl	;update pdl pointer.
05800	;initialize OWL loop for upper-right window.
05900		move XL,XM
06000		move YL,YM
06100		movem 12,apen		;anscestors.
06200		movem 13,asur
06300		hlrzm 11,asur3
06400		setzm penold		;descendants.
06500		setzm pennew
06600		setzm sur
06700		setzm sur3
06800		jrst .V
06900	BEND
     

00100	NUMTRI:	20
00200	TRIBLKS:	0
00300	BLOCK 400
00400	TRITAB:	0
00500	BLOCK 40
00600	INPUT3:
00700	DEFINE TRIANG (X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3,N)
00800	{
00900	XWD X1,Y1
01000	XWD X2,Y2
01100	XWD X3,Y3
01200	XWD Z1,Z2
01300	XWD Z3,N
01400	⎇
01500	
01600	DEFINE QUAD (X1,Y1,X2,Y2,Z12,X3,Y3,X4,Y4,Z34)
01700	{
01800	TRIANG X1,Y1,Z12,X2,Y2,Z12,X3,Y3,Z34,5
01900	TRIANG X1,Y1,Z12,X3,Y3,Z34,X4,Y4,Z34,6
02000	⎇
02100	
02200	QUAD -500,-700,-500,-200, 200, 440,-200, 440,-700,200
02300	QUAD -440,-100,-440, 200, 600, 300, -40,300,-600, 100
02400	QUAD 0,100,0,500,100,440,500,440,100,100
02500	QUAD -440,400,-440,700,600,-240,700,-240,400,600
02600	QUAD 0,500,440,500,100,-240,700,-440,700,600
02700	QUAD 0,100,440,100,100,-240,400,-440,400,600
02800	QUAD 440,100,440,500,100,-240,700,-240,400,600
02900	QUAD 0,100,0,500,100,-440,700,-440,400,600
03000	
03100	FFLAG:	-1	;FRAME FLAG
03200	OUTPDL:	.+3
03300		
03400	INPUT5:	XWD 1200,INPUT3
03500		XWD -500,-500
03600		BLOCK 14000
03700	ENDPDL:	0	↔	0	↔	0	↔	0
03800	INPUT6:	0
03900	BLOCK 40000
04000	END6:	0 ↔ 0 ↔ 0 ↔ 0
04100	END LUMEN